home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / programs.arc / SANAL.PRO < prev   
Encoding:
Text File  |  1986-10-07  |  10.9 KB  |  480 lines
  1. /* SENTENCE ANALYSIS */
  2. /*
  3.   This sample shows how sentence analysis
  4.   can be done in TURBO-PROLOG.
  5.  
  6.   As an example, the following sentence
  7.   can be recognized:
  8. "every man that lives loves a woman"
  9. */
  10.  
  11. DATABASE   /* words which can be recognized */
  12.   noun( STRING )
  13.   det( STRING )
  14.   rel( STRING )
  15.   verb( STRING )
  16.  
  17. include "menu.pro"
  18.  
  19. DOMAINS
  20.   SENTENCE = sent( NOUNP, VERBP )
  21.   NOUNP    = nounp( DETERM, STRING, RELCL)
  22.   DETERM   = none ; determ( STRING )
  23.   RELCL    = none ; relcl( STRING, VERBP )
  24.   VERBP    = verb( STRING ) ; verbp( STRING, NOUNP )
  25.   TOKL     = STRING*
  26.  
  27. /*
  28.   Domains for the tree with positions
  29. */
  30.   d_SENTENCE = sent( d_NOUNP, d_VERBP )
  31.   d_NOUNP    = nounp( d_DETERM, COL, d_RELCL)
  32.   d_DETERM   = none ; determ( COL )
  33.   d_RELCL    = none ; relcl( COL, d_VERBP )
  34.   d_VERBP    = verb( COL ) ; verbp( COL, d_NOUNP )
  35.  
  36.   ATTR = INTEGER
  37.   ROW, COL = INTEGER
  38.   COLL = COL*
  39.  
  40. PREDICATES
  41. /*
  42.   Recognition of words in different forms
  43. */
  44.   is_noun( STRING )
  45.   is_det( STRING )
  46.   is_rel( STRING )
  47.   is_verb( STRING )
  48.  
  49. /*
  50.   Parser
  51. */
  52.   s_nounp(    TOKL, TOKL, COLL, COLL, NOUNP, d_NOUNP )
  53.   s_determ(   TOKL, TOKL, COLL, COLL, DETERM, d_DETERM )
  54.   s_sentence( TOKL, TOKL, COLL, COLL, SENTENCE, d_SENTENCE )
  55.   s_relcl(    TOKL, TOKL, COLL, COLL, RELCL, d_RELCL )
  56.   s_verbp(    TOKL, TOKL, COLL, COLL, VERBP, d_VERBP )
  57.  
  58. /*
  59.   draw a sentence tree
  60. */
  61.   draw_sentence( ROW, ROW, d_SENTENCE, SENTENCE, COL )
  62.   draw_nounp( ROW, ROW, d_NOUNP, NOUNP, COL )
  63.   draw_relcl( ROW, ROW, d_RELCL, RELCL, COL )
  64.   draw_verbp( ROW, ROW, d_VERBP, VERBP, COL )
  65.  
  66. /*
  67.   Miscellaneous drawing predicates
  68. */
  69.   lin(ROW,COL,ROW,COL)
  70.   line_ver(ROW,ROW,COL)
  71.   line_hor(COL,COL,ROW)
  72.   scr_tegn(ROW,COL,CHAR)
  73.   mark(ROW,COL,STRING,ATTR)
  74.   mark2(ROW,COL,STRING,ATTR)
  75.   markfinal(ROW,COL,STRING,STRING)
  76.   mk_ulin(STRING,STRING)
  77.   writetext(ROW,COL,STRING,ATTR)
  78.  
  79. /*
  80.   scanner
  81. */
  82.   tokl( COL, COLL, STRING, TOKL )
  83.   check(STRING)
  84.   tom(TOKL).
  85.  
  86. /*
  87.   Main predicates
  88. */
  89.   sanal
  90.   run1
  91.   run2(STRING)
  92.   draw
  93.   repeat
  94.   key
  95.   process(INTEGER)
  96.  
  97. /*
  98.   Update database predicates
  99. */
  100.   updatdba
  101.   updatdba1(INTEGER)
  102.   read(STRING,STRING)
  103.  
  104. GOAL
  105.     makewindow(1,7,0,"",0,0,24,80),
  106.     sanal.
  107.  
  108. CLAUSES
  109.  
  110. repeat.
  111. repeat:-repeat.
  112.  
  113. sanal:-repeat,
  114. menu(10,20,
  115.     [ "Tutorial",
  116.       "Call dos-system",
  117.       "Call editor",
  118.       "",
  119.       "Load database from file",
  120.       "Save database on file",
  121.       "",
  122.       "Analyze a sentence",
  123.       "",
  124.       "Show/update the language"],CHOICE),
  125.  
  126. process(CHOICE),CHOICE=0,!.
  127.  
  128. process(0):-
  129.     write("\nAre you sure ? (y/n): "),
  130.     readchar(T),
  131.     T='y'.
  132. process(1):-
  133.     file_str("sanal.hlp",TXT),
  134.     display(TXT),
  135.     clearwindow,!.
  136. process(1):-write(">> Can't read sanal.hlp\n").
  137. process(2):-
  138.     makewindow(3,7,0,"",0,0,25,80),
  139.     system(""),!,
  140.     removewindow.
  141. process(2):-
  142.     write(">> command.com not accesible. press any"),
  143.     readchar(_),
  144.     removewindow.
  145. process(3):-
  146.     edit("",_),
  147.     clearwindow.
  148. process(4).
  149. process(5):-consult("sanal.dba"),!.
  150. process(5):-write(">> Can't read sanal.dba\n").
  151. process(6):-
  152.     deletefile("sanal.bak"),
  153.     renamefile("sanal.dba","sanal.bak"),
  154.     save("sanal.dba").
  155. process(7).
  156. process(8):-draw.
  157. process(9).
  158. process(10):-updatdba.
  159.  
  160. draw:-
  161.     makewindow(1,7,0,"",0,0,25,80),
  162.     run1.
  163.  
  164. draw:-removewindow.
  165.  
  166. run1:-cursor(23,0),
  167.     write("write a sentence:\n"),
  168.     readln(LN),
  169.     run2(LN),!,
  170.     run1.
  171.  
  172.  
  173. run2(LN):-
  174.     clearwindow,
  175.     tokl(5,POSL,LN,TOKL),
  176.     s_sentence( TOKL, _, POSL, _, SENT, POS ),
  177.     cursor(18,0),
  178.     write("SENTENCE=",LN),nl,nl,
  179.     write("PROLOG OBJECT=",SENT),
  180.     draw_sentence( 4, 0, POS, SENT, COL), COL<0.
  181.     run2(_).
  182.  
  183. /*
  184.   Update database
  185. */
  186.  
  187. updatdba:-
  188.     repeat,
  189.     menu(10,20,
  190.     [ "Show verbs",
  191.     "Show nouns",
  192.     "Show relatives",
  193.     "Show determiners",
  194.     "",
  195.     "New verbs",
  196.     "New nouns",
  197.     "New relatives",
  198.     "New determiners"],CHOICE),
  199.     updatdba1(CHOICE),
  200.     CHOICE=0,!.
  201.  
  202. updatdba1(0).
  203.  
  204. updatdba1(1):-
  205.     write("\n\nVerbs:\n******\n"),
  206.     verb(X),write(X,' '),
  207.     fail.
  208. updatdba1(1):-nl,key.
  209.  
  210. updatdba1(2):-
  211.     write("\n\nNouns:\n******\n"),
  212.     noun(X),write(X,' '),
  213.     fail.
  214. updatdba1(2):-nl,key.
  215.  
  216. updatdba1(3):-
  217.     write("\n\nRelatives:\n**********\n"),
  218.     rel(X),
  219.     write(X,' '),
  220.     fail.
  221. updatdba1(3):-nl,key.
  222.  
  223. updatdba1(4):-
  224.     write("\n\nDeterminers:\n************\n"),
  225.     det(X),
  226.     write(X,' '),
  227.     fail.
  228. updatdba1(4):-nl,key.
  229.  
  230. updatdba1(6):-
  231.     read("New verb",X),
  232.     assert(verb(X)).
  233. updatdba1(7):-
  234.     read("New noun",X),
  235.     assert(noun(X)).
  236. updatdba1(8):-
  237.     read("New relative",X),
  238.     assert(rel(X)).
  239. updatdba1(9):-
  240.     read("New determiner",X),
  241.     assert(det(X)).
  242.  
  243. read(TXT,ANS):-nl,
  244.     write(TXT,": "),
  245.     readln(ANS),ANS><"".
  246.  
  247. key:-
  248.     makewindow(9,135,0,"",0,0,1,18),
  249.     write(">> Press any key"),
  250.     readkey(_),
  251.     removewindow.
  252.  
  253. tom([]).
  254.  
  255. s_sentence(TOKL,TOKL2,COLL,COLL2,sent(NOUNP,VERBP),
  256.  sent(D_NOUNP,D_VERBP)):-
  257.     s_nounp(TOKL,TOKL1,COLL,COLL1,NOUNP,D_NOUNP),
  258.     s_verbp(TOKL1,TOKL2,COLL1,COLL2,VERBP,D_VERBP),
  259.     tom(TOKL2),!.
  260.  
  261. s_sentence(_,_,_,_,_,_):-
  262.     write(">> Sentence not recognized (Use F8 to get the old line)\n"),fail.
  263.  
  264. s_nounp(TOKL,TOKL2,COLL,COLL2,nounp(DETERM,NOUN,RELCL),
  265.  nounp(D_DETERM,COL,D_RELCL)):-
  266.     s_determ(TOKL,[NOUN|TOKL1],COLL,[COL|COLL1],DETERM,D_DETERM),
  267.     is_noun(NOUN),
  268.     s_relcl(TOKL1,TOKL2,COLL1,COLL2,RELCL,D_RELCL).
  269.  
  270. s_determ([DETERM|TOKL],TOKL,[COL|COLL],COLL,determ(DETERM),
  271.  determ(COL)):-
  272.     is_det(DETERM).
  273.  
  274. s_determ(TOKL,TOKL,COLL,COLL,none,none).
  275.  
  276. s_relcl([REL|TOKL],TOKL1,[COL|COLL],COLL1,relcl(REL,VERBP),
  277.  relcl(COL,D_VERBP) ):-
  278.     is_rel(REL),
  279.     s_verbp(TOKL,TOKL1,COLL,COLL1,VERBP,D_VERBP).
  280.  
  281. s_relcl(TOKL,TOKL,COLL,COLL,none,none).
  282.  
  283. s_verbp([VERB|TOKL],TOKL1,[COL|COLL],COLL1,verbp(VERB,NOUNP),
  284.  verbp(COL,D_NOUNP)):-
  285.     is_verb(VERB),
  286.     s_nounp(TOKL,TOKL1,COLL,COLL1,NOUNP,D_NOUNP).
  287.  
  288. s_verbp([VERB|TOKL],TOKL,[COL|COLL],COLL,verb(VERB),verb(COL)):-
  289.     is_verb(VERB).
  290.  
  291. tokl(POS,[POS1|POSL],STR,[TOK|TOKL]) :-
  292.     fronttoken(STR,TOK,STR1),
  293.     check(TOK),!,
  294.     str_len(TOK,LEN),
  295.     POS1=POS+(LEN+1) div 2,
  296.     POS2=POS+5+LEN,
  297.     tokl(POS2,POSL,STR1,TOKL).
  298. tokl(_,[],_,[]).
  299.  
  300. check(WORD):-is_noun(WORD),!.
  301. check(WORD):-is_det(WORD),!.
  302. check(WORD):-is_rel(WORD),!.
  303. check(WORD):-is_verb(WORD),!.
  304. check(WORD):-
  305.     write(">> Unknown word: ",WORD),nl,
  306.     readchar(_).
  307.  
  308. is_noun(X):-noun(X).
  309. is_noun(X):-noun(Y),concat(Y,"s",X).
  310. is_det(X):-det(X).
  311. is_rel(X):-rel(X).
  312. is_verb(X):-verb(X).
  313. is_verb(X):-verb(Y),concat(Y,"s",X).
  314. is_verb(X):-verb(Y),concat(Y,"ed",X).
  315. is_verb(X):-verb(Y),concat(Y,"es",X).
  316. is_verb(X):-verb(Y),concat(Y,"ing",X).
  317.  
  318. draw_sentence(STEP,DEPT,sent(D_NOUNP,D_VERBP),sent(NOUNP,VERBP),COL):-
  319.     DEPT1=DEPT+STEP,
  320.     draw_nounp(STEP,DEPT1,D_NOUNP,NOUNP,COL1),
  321.     draw_verbp(STEP,DEPT1,D_VERBP,VERBP,COL2),
  322.     COL=(COL1+COL2) div 2,
  323.     lin(DEPT,COL,DEPT1,COL1),
  324.     lin(DEPT,COL,DEPT1,COL2),
  325.     mark(DEPT,COL,"SENTENCE",33).
  326.  
  327. draw_nounp(STEP,DEPT,nounp(none,COL,none),nounp(_,NOUN,_),COL):-
  328.     DEPT1=DEPT+STEP div 2,
  329.     lin(DEPT1,COL,DEPT,COL),
  330.     markfinal(DEPT1,COL,"NOUN",NOUN),
  331.     mark(DEPT,COL,"NOUNP",33).
  332.  
  333. draw_nounp(STEP,DEPT,nounp(determ(COL1),COL2,none),
  334.  nounp(determ(DET),NOUN,_),COL):-
  335.     DEPT1=DEPT+STEP,
  336.     COL=(COL1+COL2) div 2,
  337.     lin(DEPT1,COL1,DEPT,COL),
  338.     lin(DEPT1,COL2,DEPT,COL),
  339.     markfinal(DEPT1,COL1,"DETERM",DET),
  340.     markfinal(DEPT1,COL2,"NOUN",NOUN),
  341.     mark(DEPT,COl,"NOUNP",33).
  342.  
  343. draw_nounp(STEP,DEPT,nounp(none,COL1,relcl(REL,VERBP)),
  344.  nounp(none,NOUN,RELCL),COL):-
  345.     DEPT1=DEPT+STEP,
  346.     draw_relcl(STEP,DEPT1,relcl(REL,VERBP),RELCL,COL2),
  347.     COL=(COL1+COL2) div 2,
  348.     lin(DEPT1,COL1,DEPT,COL),
  349.     lin(DEPT1,COL2,DEPT,COL),
  350.     markfinal(DEPT1,COL1,"NOUN",NOUN),
  351.     mark(DEPT,COL,"NOUNP",33).
  352.  
  353. draw_nounp(STEP,DEPT,nounp(determ(COL1),COL2,relcl(REL,VERBP)),
  354.  nounp(determ(DET),NOUN,RELCL),COL):-
  355.     DEPT1=DEPT+STEP,
  356.     draw_relcl(STEP,DEPT1,relcl(REL,VERBP),RELCL,COL3),
  357.     COL=(COL1+COL2+COL3) div 3,
  358.     lin(DEPT1,COL1,DEPT,COL),
  359.     lin(DEPT1,COL2,DEPT,COL),
  360.     lin(DEPT1,COL3,DEPT,COL),
  361.     markfinal(DEPT1,COL1,"DETERM",DET),
  362.     markfinal(DEPT1,COL2,"NOUN",NOUN),
  363.     mark(DEPT,COL,"NOUNP",33).
  364.  
  365. draw_verbp(STEP,DEPT,verb(COL),verb(VERB),COL):-
  366.     DEPT1=DEPT+STEP div 2,
  367.     lin(DEPT1,COL,DEPT,COL),
  368.     markfinal(DEPT1,COL,"VERB",VERB),
  369.     mark(DEPT,COL,"VERBP",33).
  370.  
  371. draw_verbp(STEP,DEPT,verbp(COL1,D_NOUNP),verbp(VERB,NOUNP),COL):-
  372.     DEPT1=DEPT+STEP,
  373.     draw_nounp(STEP,DEPT1,D_NOUNP,NOUNP,COL2),
  374.     COL=(COL1+COL2) div 2,
  375.     lin(DEPT1,COL1,DEPT,COL),
  376.     lin(DEPT1,COL2,DEPT,COL),
  377.     markfinal(DEPT1,COL1,"VERB",VERB),
  378.     mark(DEPT,COL,"VERBP",33).
  379.  
  380. draw_relcl(STEP,DEPT,relcl(COL1,D_VERBP),relcl(REL,VERBP),COL):-
  381.     DEPT1=DEPT+STEP,
  382.     draw_verbp(STEP,DEPT1,D_VERBP,VERBP,COL2),
  383.     COL=(COL1+COL2) div 2,
  384.     lin(DEPT1,COL1,DEPT,COL),
  385.     lin(DEPT1,COL2,DEPT,COL),
  386.     markfinal(DEPT1,COL1,"REL",REL),
  387.     mark(DEPT,COL,"RELCL",33).
  388.  
  389. lin(R1,C,R2,C):-!,
  390.     line_ver(R1,R2,C).
  391. lin(R1,C1,R2,C2):-
  392.     RM=(R1+R2) div 2,
  393.     line_ver(R1,RM,C1),
  394.     line_hor(C1,C2,RM),
  395.     line_ver(RM,R2,C2),
  396.     scr_tegn(RM,C1,'+'),
  397.     scr_tegn(RM,C2,'+').
  398.  
  399. line_ver(R,R,_):-!.
  400. line_ver(R1,R2,C):-
  401.     R2>R1,!,
  402.     scr_tegn(R1,C,'|'),
  403.     R=R1+1,
  404.     line_ver(R,R2,C).
  405. line_ver(R2,R1,C):-
  406.     scr_tegn(R1,C,'|'),
  407.     R=R1+1,
  408.     line_ver(R,R2,C).
  409.  
  410. line_hor(C,C,_):-!.
  411. line_hor(C1,C2,R):-
  412.     C2>C1,!,
  413.     scr_tegn(R,C1,'-'),
  414.     C=C1+1,
  415.     line_hor(C,C2,R).
  416. line_hor(C2,C1,R):-
  417.     scr_tegn(R,C1,'-'),
  418.     C=C1+1,
  419.     line_hor(C,C2,R).
  420.  
  421. mark(ROW,COL,TEXT,ATTR):-
  422.     str_len(TEXT,LEN),
  423.     C=COL-(LEN-1) div 2,
  424.     writetext(ROW,C,TEXT,ATTR).
  425.  
  426. mark2(ROW,COL,TEXT,ATTR):-
  427.     str_len(TEXT,LEN),
  428.     C=COL-LEN div 2,
  429.     writetext(ROW,C,TEXT,ATTR).
  430.  
  431. markfinal(ROW,COL,TEXT1,TEXT2):-
  432.     str_len(TEXT1,L1),
  433.     str_len(TEXT2,L2),
  434.     L2>L1,!,
  435.     R1=ROW+1, R2=ROW+2,
  436.     mk_ulin(TEXT1,ULINE),
  437.     mark2(ROW,COL,TEXT1,33),
  438.     mark2(R1,COL,ULINE,7),
  439.     mark(R2,COL,TEXT2,112).
  440.  
  441. markfinal(ROW,COL,TEXT1,TEXT2):-
  442.     str_len(TEXT1,L),
  443.     str_len(TEXT2,L),!,
  444.     R1=ROW+1,
  445.     R2=ROW+2,
  446.     mk_ulin(TEXT1,ULINE),
  447.     mark(ROW,COL,TEXT1,33),
  448.     mark(R1,COL,ULINE,7),
  449.     mark(R2,COL,TEXT2,112).
  450.  
  451. markfinal(ROW,COL,TEXT1,TEXT2):-
  452.     R1=ROW+1,
  453.     R2=ROW+2,
  454.     mk_ulin(TEXT1,ULINE),
  455.     mark(ROW,COL,TEXT1,33),
  456.     mark(R1,COL,ULINE,7),
  457.     mark2(R2,COL,TEXT2,112).
  458.  
  459. mk_ulin(STR1,STR2):-
  460.     frontchar(STR1,_,REST),!,
  461.     mk_ulin(REST,ULI1),
  462.     concat(ULI1,"-",STR2).
  463.     mk_ulin("","").
  464.  
  465. scr_tegn(R,C,CH):-
  466.     R<25,
  467.     C<80,!,
  468.     scr_char(R,C,CH).
  469.     scr_tegn(_,_,_).
  470.  
  471. writetext(ROW,COL,TEXT,ATTR):-
  472.     ROW<25,
  473.     COL<80,
  474.     frontchar(TEXT,CH,REST),!,
  475.     scr_char(ROW,COL,CH),
  476.     scr_attr(ROW,COL,ATTR),
  477.     COL1=COL+1,
  478.     writetext(ROW,COL1,REST,ATTR).
  479.     writetext(_,_,_,_).
  480.